;> Stmt2 poly, graphics, file io, mos emulator
 [ RELEASE=0
MANDEL BL AEEXPR
 BL FLOATY
 TEQ R10,#","
 BNE ERSYNT
 BL FPUSH ;d
 BL EXPR
 BL AEDONE
 BL FLOATY
 BL FPUSH ;e
 MOV AELINE,#0
 STMFD SP!,{AELINE}
 STMFD SP!,{AELINE}
 STMFD SP!,{AELINE}
 STMFD SP!,{AELINE}
 STMFD SP!,{AELINE}
 STMFD SP!,{AELINE}
 STMFD SP!,{AELINE}
 STMFD SP!,{AELINE}
MAND1 MOV TYPE,SP
 BL FLDA;a
 ADD TYPE,SP,#8
 BL FMUL ;a*b
 ADD FACCX,FACCX,#1 ;a*b*2
 ADD TYPE,SP,#40;d
 BL FADD ;a*b*2+d
 ADD TYPE,SP,#8
 BL FSTA ;b=a*b*2+d
 ADD TYPE,SP,#24
 BL FLDA;q
 ADD TYPE,SP,#16
 BL FXSUB ;-q+p
 ADD TYPE,SP,#32
 BL FADD ;-q+p+e
 ADD TYPE,SP,#0
 BL FSTA ;a=p-q+e
 BL FSQR ;a^2
 ADD TYPE,SP,#16
 BL FSTA ;p=a^2
 ADD TYPE,SP,#8
 BL FLDA
 BL FSQR
 ADD TYPE,SP,#24
 BL FSTA ;q=b^2
 ADD AELINE,AELINE,#1
 LDR TYPE,[ARGP,#INTVAR+4*4]
 CMP AELINE,TYPE
 BCS MAND2
 ADD TYPE,SP,#16
 BL FADD
 CMP FACCX,#&83
 BCC MAND1
MAND2 STR AELINE,[ARGP,#INTVAR+4*3]
 ADD SP,SP,#48
 B NXT
 ]
;statements (of the poly variety)
LERROR BL INTEXA
 STMFD SP!,{FACC}
 BL EXPR
 BNE ERTYPESTR
 BL AEDONE
 LDMFD SP!,{R7}
 MOV R0,#0
 STRB R0,[CLEN],#1 ;0 at end of string
 BL SPUSH
 STR R7,[SP]
 MOV R14,SP
 B MSGERR
LPAGE BL EQAEEX
 ADD FACC,FACC,#3
 BIC FACC,FACC,#3
 ADD R1,ARGP,#FREE
 CMP FACC,R1
 BCC LPAGEOUT
 LDR R1,[ARGP,#MEMLIMIT]
 CMP FACC,R1
 BCS LPAGEOUT
 STR FACC,[ARGP,#PAGE]
 BL SETVAL
 B NXT
LPAGEOUT BL VSTRNG
 = "Out of range value assigned to PAGE",10,13,0
 B NXT
LTIME LDRB R10,[LINE]
 CMP R10,#"$"
 BEQ LTIMED
 BL EQAEEX
 MOV R4,FACC
 MOV R0,#1
 ADD R1,ARGP,#STRACC
 SWI WORD ;time now
 LDR FACC,[R1]
 SUB FACC,FACC,R4 ;what the offset has to be
 STR FACC,[ARGP,#TIMEOF]
 B NXT
LTIMED ADD LINE,LINE,#1
 BL SPACES
 CMP R10,#"="
 BNE MISSEQ
 BL AEEXPR
 BNE ERTYPESTR
 BL AEDONE
 ADD R1,ARGP,#STRACC
 SUB R0,CLEN,R1
 STRB R0,[R1,#-1]!
 MOV R0,#15
 SWI WORD
 B NXT
LLOMEM BL EQAEEX
 ADD FACC,FACC,#3
 BIC FACC,FACC,#3
 ADD R1,ARGP,#FREE
 CMP FACC,R1
 BCC LLOMEMOUT
 LDR R1,[ARGP,#MEMLIMIT]
 CMP FACC,R1
 BCS LLOMEMOUT
 STR FACC,[ARGP,#LOMEM]
 STR FACC,[ARGP,#FSA]
 MOV R0,#0
 STR R0,[ARGP,#FREELIST]
 BL SETVAL
 B NXT
LLOMEMOUT BL VSTRNG
 = "Out of range value assigned to LOMEM",10,13,0
 B NXT
LHIMEM BL EQAEEX
 BIC FACC,FACC,#3
 ADD R1,ARGP,#FREE
 CMP FACC,R1
 BCC LHIMEMOUT
 LDR R1,[ARGP,#MEMLIMIT]
 CMP FACC,R1
 BCS LHIMEMOUT
 STR FACC,[ARGP,#HIMEM]
 BL POPLOCALAR
 LDR SP,[ARGP,#HIMEM]
 MOV R0,#0
 STMFD SP!,{R0-R9} ;stack stop
 STR SP,[ARGP,#ERRSTK]
 B NXT
LHIMEMOUT BL VSTRNG
 = "Out of range value assigned to HIMEM",10,13,0
 B NXT
LLEFTD BL AELV
 BEQ FACERR
 CMP TYPE,#128
 BNE ERTYPESTRING
 STMFD SP!,{FACC}
 MOV FACC,#1
 STMFD SP!,{FACC}
 BL AESPAC
 MOV FACC,#255
 CMP R10,#","
 BNE LMIDD1
 BL EXPR
 BL INTEGZ
 B LMIDD1 
LMIDD BL AELV
 BEQ FACERR
 CMP TYPE,#128
 BNE ERTYPESTRING
 BL AESPAC
 CMP R10,#","
 BNE ERCOMM
 STMFD SP!,{FACC}
 BL EXPR
 BL INTEGZ
 STMFD SP!,{FACC}
 MOV R0,#255
 CMP R10,#","
 BNE LMIDD1
 BL EXPR
 BL INTEGZ
LMIDD1 STMFD SP!,{FACC}
 CMP R10,#")"
 BNE ERBRA
 BL AESPAC
 CMP R10,#"="
 BNE MISSEQ
 BL EXPR
 BNE ERTYPESTR
 BL AEDONE
 LDMFD SP!,{R4,R5,R6}
 ADD R1,ARGP,#STRACC
 CMP CLEN,R1
 BEQ NXT ;no right string
;R4 is max length, R5 is start position, R6 is pointer to string block
LRIGHTD2 LOAD FACC,R6,R1,R7
 SUB R1,R5,#1
 CMP R1,#255
 MOVCS R5,#1
 LDRB R1,[R6,#4] ;get length
 CMP R5,R1
 BHI NXT
 ADD R1,FACC,R1
 ADD R7,FACC,R5
 SUB R7,R7,#1 ;start address
 ADD R3,ARGP,#STRACC
LMIDD2 LDRB R5,[R3],#1
 STRB R5,[R7],#1
 TEQ R3,CLEN
 BEQ NXT ;exhausted right string
 CMP R7,R1
 BCS NXT ;exhausted left string
 SUBS R4,R4,#1
 BHI LMIDD2
 B NXT
LRIGHTD BL AELV
 BEQ FACERR
 CMP TYPE,#128
 BNE ERTYPESTRING
 STMFD SP!,{FACC}
 BL AESPAC
 MOV FACC,#255
 CMP R10,#","
 BNE LRIGHTD1
 BL EXPR
 BL INTEGZ
LRIGHTD1 STMFD SP!,{FACC}
 CMP R10,#")"
 BNE ERBRA
 BL AESPAC
 CMP R10,#"="
 BNE MISSEQ
 BL EXPR
 BNE ERTYPESTR
 BL AEDONE
 LDMFD SP!,{R4,R6}
 ADD R1,ARGP,#STRACC
 SUBS R0,CLEN,R1 ;length of rightside
 BEQ NXT ;no right string
 CMP R4,R0
 MOVCS R4,R0
 LDRB R5,[R6,#4]
 SUBS R5,R5,R4
 ADD R5,R5,#1
 BCS LRIGHTD2
 B NXT
; graphics
CLG BL DONES
 BL CTALLY
 SWI WRITEI+16
 B NXT
CLS BL DONES
 BL CTALLY
 SWI WRITEI+12
 B NXT
CIRCLE MOV R0,#&95
 MOV R1,#&9D
 BL CHECKFILL
 STMFD SP!,{FACC}
 BL INTEXA
 STMFD SP!,{FACC}
 BL INTEXC
 STMFD SP!,{FACC}
 BL EXPRDN
 LDMFD SP!,{R3,R4}
 ADD R1,R4,FACC
 SWI WRITEI+25
 SWI WRITEI+4
 MOV R0,R4
 BL WRITEG
 MOV R0,R3
 BL WRITEG
 SWI WRITEI+25
 LDMFD SP!,{R2}
 B PLOTACT
CHECKFILL STMFD SP!,{R14}
 BL SPACES
 CMP R10,#TESCSTMT
 BNE CHECKFILL1
 LDRB R10,[LINE],#1
 TEQ R10,#TFILL
 MOVEQ R0,R1
 LDMEQFD SP!,{PC}
 SUB LINE,LINE,#1
CHECKFILL1 SUB LINE,LINE,#1
 LDMFD SP!,{PC}
COLOUR BL AEEXPR
 BL INTEGZ
 CMP R10,#TESCSTMT
 BEQ COLOURTINT
 TEQ R10,#","
 BEQ PALETTE
 BL AEDONE
 SWI WRITEI+17
 SWI WRITEC
 B NXT
COLOURTINT LDRB R10,[AELINE],#1
 CMP R10,#TTINT
 BNE ERSYNT
 STMFD SP!,{FACC}
 BL EXPRDN
 MOV R1,FACC
 LDMFD SP!,{FACC}
 SWI WRITEI+17
 SWI WRITEC
 MOV FACC,FACC,LSR #7
 AND FACC,FACC,#1
 B TINTEND
PALETTE STMFD SP!,{FACC}
 BL EXPR
 BL INTEGZ
 TEQ R10,#","
 BEQ PALETTE4
 BL AEDONE
 MOV R1,FACC
 LDMFD SP!,{FACC}
 SWI WRITEI+19
 SWI WRITEC
 MOV FACC,R1
 BL WRITEG
 MOV FACC,R1,LSR #16
 SWI WRITEC
 MOV FACC,R1,LSR #24
 SWI WRITEC
 B NXT
PALETTE4 STMFD SP!,{FACC}
 BL INTEXC
 STMFD SP!,{FACC}
 BL EXPRDN
 MOV R5,FACC
 SWI WRITEI+19
 LDMFD SP!,{R1,R2,R3}
 MOV FACC,R3
 SWI WRITEC
 SWI WRITEI+16
 MOV FACC,R2
 SWI WRITEC
 MOV FACC,R1
 SWI WRITEC
 MOV FACC,R5
 SWI WRITEC
 B NXT
CURSON SWI WRITEI+23
 SWI WRITEI+1
 SWI WRITEI+1
 BL FLUSH7
 B NXT
CURSOFF BL DONES
 SWI WRITEI+23
 SWI WRITEI+1
 BL FLUSH8
 B NXT
DRAW MOV FACC,#5
 B PLOTER
FILL MOV FACC,#&85
 B PLOTER
GCOL BL AEEXPR
 BL INTEGZ
 CMP R10,#","
 BEQ GCOL2
 CMP R10,#TESCSTMT
 BEQ GCOL1TINT
 BL AEDONE
 SWI WRITEI+18
 SWI WRITEI+0
 SWI WRITEC
 B NXT
GCOL1TINT MOV R1,R0
 MOV R0,#0
GCOLTINT LDRB R10,[AELINE],#1
 CMP R10,#TTINT
 BNE ERSYNT
 STMFD SP!,{R0,R1}
 BL EXPRDN
 MOV R1,FACC
 LDMFD SP!,{R0,R2}
 SWI WRITEI+18
 SWI WRITEC
 MOV R0,R2
 SWI WRITEC
 TST R0,#128
 MOVEQ R0,#2
 MOVNE R0,#3
 B TINTEND
GCOL2 STMFD SP!,{FACC}
 BL EXPR
 BL INTEGZ
 MOV R1,FACC
 LDMFD SP!,{FACC}
 CMP R10,#TESCSTMT
 BEQ GCOLTINT
 SWI WRITEI+18
 SWI WRITEC
 MOV FACC,R1
 SWI WRITEC
 B NXT
LINEST BL SPACES
 TEQ R10,#TINPUT
 MOVEQ R5,#0
 MOVEQ R4,#0
 BEQ INPLP
 SUB LINE,LINE,#1
 BL INTEXA
 STMFD SP!,{FACC}
 BL INTEXC
 STMFD SP!,{FACC}
 BL INTEXC
 STMFD SP!,{FACC}
 BL EXPRDN
 LDMFD SP!,{R1,R2,R4}
 MOV R3,FACC
 SWI WRITEI+25
 SWI WRITEI+4
 MOV R0,R4
 BL WRITEG
 MOV R0,R2
 BL WRITEG
 SWI WRITEI+25
 SWI WRITEI+5
 B PLOT13
MODES BL AEEXDN
 BL CTALLY
 SWI WRITEI+22
 SWI WRITEC
 B NXT
DOMOUSE BL SPACES
 CMP R10,#TTEXT
 BEQ DOMOUSECOLOUR
 CMP R10,#TON
 BEQ DOMOUSEON
 CMP R10,#TOFF
 BEQ DOMOUSEOFF
 CMP R10,#TTO
 BEQ DOMOUSETO
 CMP R10,#TSTEP
 BEQ DOMOUSESTEP
 CMP R10,#TESCSTMT
 BEQ DOMOUSERECT
 SUB LINE,LINE,#1
 BL CRAELV
 BEQ ERMOUS
 CMP TYPE,#128
 BCS ERMOUS
 STMFD SP!,{FACC,TYPE}
 MOV LINE,AELINE
 BL SPACES
 CMP R10,#","
 BNE ERCOMM
 BL CRAELV
 BEQ ERMOUS
 CMP TYPE,#128
 BCS ERMOUS
 STMFD SP!,{FACC,TYPE}
 MOV LINE,AELINE
 BL SPACES
 CMP R10,#","
 BNE ERCOMM
 BL CRAELV
 BEQ ERMOUS
 CMP TYPE,#128
 BCS ERMOUS
 MOV LINE,AELINE
 BL DONES
 STMFD SP!,{FACC,TYPE}
 SWI MOUSE
 MOV R6,R0
 MOV R7,R1
 MOV R0,R2
 MOV TYPE,#TINTEGER
 BL STORE ;store switches in last one
 MOV R0,R7
 MOV TYPE,#TINTEGER
 BL STORE ;store y
 MOV R0,R6
 MOV TYPE,#TINTEGER
 BL STORE ;store x
 B NXT
DOMOUSERECT LDRB R10,[LINE],#1
 CMP R10,#TRECT
 BNE ERSYNT
 BL INTEXA
 STMFD SP!,{FACC}
 BL INTEXC
 STMFD SP!,{FACC}
 BL INTEXC
 STMFD SP!,{FACC}
 BL EXPRDN
 LDMFD SP!,{R1,R2,R3}
 ADD R4,R2,R0
 ADD R5,R1,R3
;R3 XLO,R2 YLO,R5 XHI,R4 YHI
 MOV R0,#&FF
 ORR R0,R0,#&FF00
 AND R3,R3,R0
 ORR R2,R3,R2,LSL #16
 AND R5,R5,R0
 ORR R3,R5,R4,LSL #16
 ADD R1,ARGP,#STRACC
 ADD R1,R1,#3
 MOV R0,#1
 STRB R0,[R1]
 STR R2,[R1,#1]
 STR R3,[R1,#5]
 MOV R0,#&15
 SWI WORD
 B NXT
DOMOUSESTEP BL AEEXPR
 BL INTEGZ
 AND R1,FACC,#&FF
 CMP R10,#","
 BNE DOMOUSESTEP1
 STMFD SP!,{FACC}
 BL EXPR
 BL INTEGZ
 AND R1,FACC,#&FF
 LDMFD SP!,{FACC}
DOMOUSESTEP1 BL AEDONE
 MOV FACC,FACC,LSL #8
 AND FACC,FACC,#&FF00
 ORR FACC,FACC,#2
 ORR FACC,FACC,R1,LSL #16
 ADD R1,ARGP,#STRACC
 STR FACC,[R1]
 MOV R0,#&15
 SWI WORD
 B NXT
DOMOUSETO BL INTEXA
 STMFD SP!,{FACC}
 BL EXPRDN
 LDMFD SP!,{R1}
 STMFD SP!,{FACC}
 MOV R1,R1,LSL #16
 ORR R1,R1,#&300
 STMFD SP!,{R1}
 ADD R1,SP,#1
 MOV R0,#&15
 SWI WORD
 ADD SP,SP,#8
 B NXT
DOMOUSEOFF MOV FACC,#0
 BL DONES
 B DOMOUSEON1
DOMOUSEON MOV FACC,#1
 BL SPACES
 CMP R10,#":"
 CMPNE R10,#13
 CMPNE R10,#TELSE
 BEQ DOMOUSEON1
 SUB LINE,LINE,#1
 BL AEEXDN
DOMOUSEON1 MOV R1,FACC
 MOV R0,#106
 SWI BYTE
 B NXT
DOMOUSECOLOUR BL INTEXA
 STMFD SP!,{FACC}
 BL INTEXC
 STMFD SP!,{FACC}
 BL INTEXC
 STMFD SP!,{FACC}
 BL EXPRDN
 MOV R5,FACC
 SWI WRITEI+19
 LDMFD SP!,{R1,R2,R3}
 MOV FACC,R3
 SWI WRITEC
 SWI WRITEI+25
 MOV FACC,R2
 SWI WRITEC
 MOV FACC,R1
 SWI WRITEC
 MOV FACC,R5
 SWI WRITEC
 B NXT
MOVE MOV FACC,#4
PLOTER BL SPACES
PLOTER1 CMP R10,#"B"
 SUBNE LINE,LINE,#1
 BNE PLOTER2
 LDRB R10,[LINE],#1
 CMP R10,#"Y"
 SUBEQ FACC,FACC,#4
 SUBNE LINE,LINE,#2
 B PLOTER2
ORGIN BL INTEXA
 STMFD SP!,{FACC}
 BL EXPRDN
 SWI WRITEI+29
 LDMFD SP!,{R1}
 MOV R3,FACC
 B PLOT13
PLOT BL INTEXA
 MOV LINE,AELINE
PLOTER2 STMFD SP!,{FACC}
 BL INTEXA
 STMFD SP!,{FACC}
 BL EXPRDN
 LDMFD SP!,{R1,R2}
 MOV R3,FACC
 SWI WRITEI+25
PLOTACT MOV R0,R2 ;action in R2, X in R1, Y in R3
 SWI WRITEC
PLOT13 MOV R0,R1
 BL WRITEG
 MOV R0,R3
 BL WRITEG
 B NXT
PSET BL SPACES
 MOV FACC,#&45
 CMP R10,#TTO
 BNE PLOTER1
 BL INTEXA ;point to
 STMFD SP!,{FACC}
 BL EXPRDN
 LDMFD SP!,{R1}
 STMFD SP!,{FACC}
 MOV R1,R1,LSL #16
 ORR R1,R1,#&500
 STMFD SP!,{R1}
 ADD R1,SP,#1
 MOV R0,#&15
 SWI WORD
 ADD SP,SP,#8
 B NXT
RECT MOV R0,#0
 MOV R1,#&65
 BL CHECKFILL
 STMFD SP!,{FACC}
 BL INTEXA
 STMFD SP!,{FACC} ;X
 BL INTEXC
 STMFD SP!,{FACC} ;Y
 BL EXPR
 BL INTEGZ
 STMFD SP!,{FACC} ;W
 CMP R10,#","
 BNE RECTSIMPLE
 BL EXPR
 BL INTEGZ
RECTSIMPLE LDMFD SP!,{R3,R4,R5}
 ADD R1,R5,R3 ;X+W
 ADD R3,R4,FACC ;Y+H
 CMP R10,#TTO
 BEQ RECTMOVE
 BL AEDONE
 SWI WRITEI+25
 SWI WRITEI+4
 MOV R0,R5
 BL WRITEG
 MOV R0,R4
 BL WRITEG
 LDMFD SP!,{R2}
 SWI WRITEI+25
 TEQ R2,#0
 BNE PLOTACT
 SWI WRITEI+13
 MOV R0,R1
 BL WRITEG
 MOV R0,R4
 BL WRITEG
 SWI WRITEI+25
 SWI WRITEI+13
 MOV R0,R1
 BL WRITEG
 MOV R0,R3
 BL WRITEG
 SWI WRITEI+25
 SWI WRITEI+13
 MOV R0,R5
 BL WRITEG
 MOV R0,R3
 BL WRITEG
 SWI WRITEI+25
 SWI WRITEI+13
 MOV R0,R5
 BL WRITEG
 MOV R0,R4
 BL WRITEG
 B NXT
RECTMOVE STMFD SP!,{R1,R3,R4,R5} ;x2, y2, y, x
 BL INTEXC
 STMFD SP!,{FACC}
 BL EXPRDN
 LDMFD SP!,{R1,R2,R3,R4,R5,R6}
 MOV R7,FACC
; r1: x3, r2: x2, r3: y2, r4: y, r5: x, r6: type, r7: y3
 SWI WRITEI+25
 SWI WRITEI+4
 MOV R0,R5
 BL WRITEG
 MOV R0,R4
 BL WRITEG
 SWI WRITEI+25
 SWI WRITEI+4
 MOV R0,R2
 BL WRITEG
 MOV R0,R3
 BL WRITEG
 TEQ R6,#0
 SWI WRITEI+25
 SWIEQ WRITEI+&BE
 SWINE WRITEI+&BD
 MOV R0,R1
 BL WRITEG
 MOV R0,R7
 BL WRITEG
 B NXT
DOTINT BL INTEXA
 STMFD SP!,{FACC}
 BL EXPRDN
 MOV R1,FACC
 LDMFD SP!,{FACC}
;TINT R0,R1
TINTEND SWI WRITEI+23
 SWI WRITEI+17
 SWI WRITEC
 MOV FACC,R1
 SWI WRITEC
 SWI WRITEI+0
 SWI WRITEI+0
 SWI WRITEI+0
 SWI WRITEI+0
 SWI WRITEI+0
 SWI WRITEI+0
 B NXT
VDUP MOV FACC,FACC,LSR #8
 SWI WRITEC
VDU BL SPACES
VDUL CMP R10,#":"
 BEQ NXT
 CMP R10,#13
 BEQ NXT
 CMP R10,#TELSE
 BEQ NXT
 SUB AELINE,LINE,#1
 BL EXPR
 MOV LINE,AELINE
 BL INTEGZ
 SWI WRITEC
 CMP R10,#","
 BEQ VDU
 CMP R10,#";"
 BEQ VDUP
 CMP R10,#"|"
 BNE VDUL
 BL FLUSH8
 SWI WRITEI+0
 B VDU
WRITEG SWI WRITEC
 MOV FACC,FACC,LSR #8
 SWI WRITEC
 MOV PC,R14
WAIT BL DONES
 MOV R0,#19
 SWI BYTE
 B NXT
;file io
LEXT MOV R0,#3
 B LPTRA
LPTR MOV R0,#1
LPTRA STMFD SP!,{R0}
 BL AECHAN
 STMFD SP!,{FACC}
 MOV LINE,AELINE
 BL EQAEEX
 MOV R2,FACC
 LDMFD SP!,{R1}
 LDMFD SP!,{R0}
 SWI ARGS
 B NXT
BBPUT BL AECHAN
 BL AESPAC
 CMP R10,#","
 BNE ERCOMM
 STMFD SP!,{R1}
 BL EXPR
 BEQ BBPUT1
 BLMI INTEGB
 BL AEDONE
 LDMFD SP!,{R1}
 SWI BPUT
 B NXT
BBPUT1 TEQ R10,#";"
 MOVNE R0,#10
 STRNEB R0,[CLEN],#1
 BLEQ AESPAC
 BL AEDONE
 ADD R3,ARGP,#STRACC
 LDMFD SP!,{R1}
BBPUT2 TEQ CLEN,R3
 LDRNEB R0,[R3],#1
 SWINE BPUT
 BNE BBPUT2
 B NXT
CLOSE BL AECHAN
 BL AESPAC
 BL AEDONE
 MOV R0,#0
 SWI OPEN
 B NXT
INPUTH MOV AELINE,LINE
 BL CHANNL
 STMFD SP!,{FACC} ;save channel as TOS
INPHLP MOV LINE,AELINE
 BL SPACES
 CMP R10,#","
 BNE INPHEX
 BL CRAELV
 BEQ ERSYNT
 MOV R4,FACC
 MOV R5,TYPE
 LDR R1,[SP] ;channel
 SWI BGET
 CMP R5,#128
 BCC INPHNO ;branch if input to number
 MOVS TYPE,R0,LSL #24
 BNE ERTYPESTR ;wanted string
 SWI BGET
 TEQ R0,#0
 ADD CLEN,ARGP,#STRACC
 ADD CLEN,CLEN,R0
 BEQ INPHSS
 MOV R3,R0
 MOV R6,CLEN
INPHSL SWI BGET
 STRB R0,[R6,#-1]!
 SUBS R3,R3,#1
 BNE INPHSL
 B INPHSS
INPHNO MOVS TYPE,R0,LSL #24
 BEQ ERTYPEINT ;wanted number
 BMI INPHNF ;read floating
 SWI BGET
 MOV R2,R0,LSL #24
 SWI BGET
 ORR R2,R2,R0,LSL #16
 SWI BGET
 ORR R2,R2,R0,LSL #8
 SWI BGET
 ORR R0,R2,R0
INPHSS BL STOREA
 B INPHLP
INPHNF ADD TYPE,ARGP,#STRACC
 MOV R2,#0
INPHFP SWI BGET
 STRB R0,[TYPE,R2]
 ADD R2,R2,#1
 CMP R2,#5
 BNE INPHFP
 LDMIA TYPE,{FACC,FACCX}
 AND FSIGN,FACC,#&80000000
 ANDS FACCX,FACCX,#255
 TEQEQ FACC,#0
 ORRNE FACC,FACC,#&80000000
 MOV TYPE,#TFP
 B INPHSS
PRTHEX MOV LINE,AELINE
INPHEX ADD SP,SP,#4 ;remove thing
 B DONEXT
PRINTH MOV AELINE,LINE
 BL CHANNL
 STMFD SP!,{FACC} ;save handle
 BL AESPAC
PRTHLP CMP R10,#","
 BNE PRTHEX
 BL EXPR
 BL FTOW ;move r0,r1,r3 to r4,r5,r7
 MOV R0,TYPE,LSR #24
 LDR R1,[SP]
 SWI BPUT
 TEQ TYPE,#0
 BEQ PRTHS
 BMI PRTHF
 MOV R0,R4,LSR #24
 SWI BPUT
 MOV R0,R4,LSR #16
 SWI BPUT
 MOV R0,R4,LSR #8
 SWI BPUT
 MOV R0,R4
 SWI BPUT
 B PRTHLP
PRTHS ADD R3,ARGP,#STRACC
 SUB R0,CLEN,R3
 SWI BPUT
 TEQ R0,#0
 BEQ PRTHLP
PRTHSL LDRB R0,[CLEN,#-1]!
 SWI BPUT
 TEQ CLEN,R3
 BNE PRTHSL
 B PRTHLP
PRTHF ADD TYPE,ARGP,#STRACC
 BL FWTOA
 BL F1STA
 LDR R1,[SP]
 ADD CLEN,TYPE,#5
PRTHFL LDRB R0,[TYPE],#1
 SWI BPUT
 TEQ TYPE,CLEN
 BNE PRTHFL
 B PRTHLP
INSTALL LDR R0,[ARGP,#HIMEM]
 LDR R1,[ARGP,#MEMLIMIT]
 CMP R0,R1
 BNE ERINSTALL
 SUB R0,R0,#11*4
 CMP R0,SP
 BCS ERINSTALL
 BL LIBSUB
 LDR R1,[ARGP,#MEMLIMIT]
 SUB R1,R1,R4
 LDR R0,[ARGP,#INSTALLLIST]
 STR R0,[R1,#-4]!
 STR R1,[ARGP,#MEMLIMIT]
 STR R1,[ARGP,#HIMEM]
 STR R1,[ARGP,#INSTALLLIST]
INSTALLCOPY LDR R0,[R2,#4]!
 STR R0,[R1,#4]!
 SUBS R4,R4,#4
 BHI INSTALLCOPY
 B NXT
LIBRARY BL LIBSUB
 LDR R3,[ARGP,#LIBRARYLIST]
 STR R2,[ARGP,#LIBRARYLIST] ;link in at list head
 STR R3,[R2],#4
 ADD R2,R2,R4
 STR R2,[ARGP,#FSA]
 B NXT
;load library to heap top: return length in R4
LIBSUB STMFD SP!,{R14}
 BL AEEXPR
 BL OSSTRI
 BL AEDONE
 MOV R0,#255
 ADD R1,ARGP,#STRACC
 LDR R2,[ARGP,#FSA]
 ADD R2,R2,#4
 MOV R3,#0
 SWI FILE
 ADD R4,R4,#3
 BIC R4,R4,#3
 LDR R2,[ARGP,#FSA]
 ADD R0,R2,#4
LIBTOP LDRB R1,[R0]
 CMP R1,#13
 BNE BADPRO1
 LDRB R1,[R0,#1]
 CMP R1,#&FF
 LDMEQFD SP!,{PC}
 LDRB R1,[R0,#3]
 CMP R1,#4
 ADDCS R0,R0,R1
 BCS LIBTOP
 B BADPRO1
OSCL BL AEEXPR
 BL OSSTRI
 BL AEDONE
 ADD R0,ARGP,#STRACC
 BL OSCLIREGS
 SWI CLI
 B NXT
SYSNAME BL MSG
 = 42,"SYS with string name not yet supported",0
 ALIGN
SYS BL AEEXPR
 BEQ SYSNAME
 BLMI INTEGB
 MOV TYPE,SP
 STMFD SP!,{FACC} ;save action
 MOV R4,#0
 MOV R5,#0
 MOV R6,#0
 MOV R7,#0
 STMFD SP!,{R4-R7,R9}
 STMFD SP!,{R4-R7} ;save 8 register holes and old sp
 CMP R10,#","
 BNE SYSCALL
;note R4 already 0
SYS0 CMP R4,#8
 BCS ERSYSINPUTS
 STMFD SP!,{R4}
 BL AESPAC
 CMP R10,#","
 BEQ SYS0COMMA
 SUB AELINE,AELINE,#1
 BL EXPR
 BEQ SYS0STRING
 LDMFD SP!,{R4}
 BL INTEGZ
 STR FACC,[SP,R4,LSL #2]
 B SYS0END
SYS0COMMA LDMFD SP!,{R4}
 B SYS0END
SYS0STRING MOV R0,#0
 STRB R0,[CLEN],#1
 LDR R7,[ARGP,#FSA]
 LDMFD SP!,{R0,R4,R5,R6,R9}
 STMIA R7!,{R0,R4,R5,R6,R9}
 LDMFD SP!,{R0,R4,R5,R6,R9}
 STMIA R7!,{R0,R4,R5,R6,R9} ;move 10 words from stack to free memory
 BL SPUSH
 LDMDB R7!,{R0,R4,R5,R6,R9} ;move 10 words back from free memory
 STMFD SP!,{R0,R4,R5,R6,R9}
 LDMDB R7!,{R0,R4,R5,R6,R9}
 STMFD SP!,{R0,R4,R5,R6,R9}
 LDMFD SP!,{R4}
 ADD R0,SP,#9*4+4 ;9 words on stack plus string length
 STR R0,[SP,R4,LSL #2]
SYS0END ADD R4,R4,#1
 CMP R10,#","
 BEQ SYS0
SYSCALL MOV LINE,AELINE
 CMP R10,#TTO
 BLNE DONE
 ADD R9,ARGP,#STRACC
 LDR R4,[SP,#8*4] ;old sp
 LDR R5,[R4,#-4] ;SWI call value
 BIC R5,R5,#&FF000000
 LDR R6,SYSDATA
 ORR R6,R6,R5
 STR R6,[R9]
 LDR R6,SYSDATA+4
 STR R6,[R9,#4]
 LDMFD SP!,{R0-R7}
 MOV R14,PC
 MOV PC,R9
 STMFD SP!,{R0-R7,PC}
 CMP R10,#TTO
 BNE SYSEXIT
 MOV R7,#0
SYS1 CMP R7,#8
 BCS ERSYSOUTPUTS
 STMFD SP!,{R7}
 BL CRAELV
 LDMFD SP!,{R7}
 BEQ SYS1COMMA
 MOV R4,FACC
 MOV R5,TYPE
 LDR FACC,[SP,R7,LSL #2]
 MOV TYPE,#TINTEGER
 CMP R5,#128
 BCC SYS1END
 MOV TYPE,#0
 ADD CLEN,ARGP,#STRACC
 ADD R3,CLEN,#256
SYS1STRING LDRB R1,[FACC],#1
 STRB R1,[CLEN],#1
 TEQ CLEN,R3
 TEQNE R1,#13
 TEQNE R1,#0
 TEQNE R1,#10
 BNE SYS1STRING
 TEQ CLEN,R3
 SUBEQ CLEN,CLEN,#255
 SUB CLEN,CLEN,#1
SYS1END STMFD SP!,{R7}
 BL STOREA
 LDMFD SP!,{R7}
SYS1ENDA ADD R7,R7,#1
 MOV LINE,AELINE
 BL SPACES
 CMP R10,#","
 BEQ SYS1
 CMP R10,#";"
 BNE SYSEXIT
 BL CRAELV
 BEQ ERSYNT
 MOV R4,FACC
 MOV R5,TYPE
 LDR FACC,[SP,#8*4]
 MOV FACC,FACC,LSR #28
 MOV TYPE,#TINTEGER
 BL STOREA
 MOV LINE,AELINE
 BL SPACES
SYSEXIT LDMFD SP!,{R0-R7,R9,SP}
 B DONEXT
SYS1COMMA BL SPACES
 CMP R10,#","
 SUBEQ AELINE,LINE,#1
 BEQ SYS1ENDA
 B ERSYNT
SYSDATA SWI 0
 MOV PC,R14
CALL BL AEEXPR
 BL INTEGY
 CMP R10,#","
 BEQ CALLARM
 BL AEDONE
 MOV TYPE,FACC
 BL EMUMOS
 BNE NXT
 MOV R4,TYPE
 MOV R5,#0
 B CALLARMGO
CALLARM MOV R4,FACC
 MOV R5,#0
CALLARMPARM STMFD SP!,{R4,R5}
 MOV LINE,AELINE
 BL CRAELV
 BEQ ERSYNT
 LDMFD SP!,{R4,R5}
 ADD R5,R5,#1
 STMFD SP!,{FACC,TYPE}
 BL AESPAC
 CMP R10,#","
 BEQ CALLARMPARM
 BL AEDONE
;Go to ARM code
CALLARMGO BL CALLARMROUT
 B NXT
CALLARMROUT MOV TYPE,SP ;pointer to list of lvs
 STMFD SP!,{R4,R5,ARGP,AELINE,LINE,R10,R14}
 MOV R10,R5 ;number
 ADD R11,ARGP,#STRACC
 ADDS R0,ARGP,#INTVAR+4
 LDMIA R0,{R0-R7} ;A%-H%
 ADR R14,CALL2
 LDMFD SP!,{PC} ;go there!
OSCLIREGS ADR R5,CALL2
 MOV R4,SP
 MOV R3,LINE
 MOV R2,ARGP
 LDR R1,[R5,#-4]
 MOV PC,R14
;enter user with:
;r8  points to basic's ARGP workspace
;r9  pointer to list of lvs
;r10 number of lvs
;r11 STRACC
;r12 LINE
;r13 points to FD stack
;r14 link back to ab
CALL2REAL LDMFD SP!,{R5,ARGP,AELINE,LINE,R10,R14}
 ADD SP,SP,R5,LSL #3 ;pop stack by two words per parameter
 MOVVC PC,R14
 BIC R14,R0,#&FC000003
 B MSGERR
 DCD &BA51C005
CALL2 B CALL2REAL ;0th entry in table is return address
;words offset from ARGP
 & STRACC
 & PAGE
 & TOP
 & LOMEM
 & HIMEM
 & MEMLIMIT
 & FSA
 & TALLY
 & TIMEOF
 & ESCWORD
 & WIDTHLOC
;internal basic routines
 B VARIND
 B STOREA
 B STSTORE
 B LVBLNK
 B CREATE
 B EXPR
 B CLIENTMATCH
 B TOKENADDR
 & 0
;MOS emulation of r9 call
EMUMOS MOV R7,R9,LSR #8
 TEQ R7,#&FF
 BNE NOTMOS
 AND R7,R9,#&FF
 LDR R0,[ARGP,#INTVAR+4]
 LDR R1,[ARGP,#INTVAR+("X"-"@")*4]
 LDR R2,[ARGP,#INTVAR+("Y"-"@")*4]
 TEQ R7,#&F7
 BEQ MOSCLI
 TEQ R7,#&F4
 BEQ MOSBYTE
 TEQ R7,#&F1
 BEQ MOSWORD
 TEQ R7,#&EE
 BEQ MOSWRCH
 TEQ R7,#&E7
 BEQ MOSNEWL
 TEQ R7,#&E3
 BEQ MOSASCI
 TEQ R7,#&E0
 BEQ MOSRDCH
 TEQ R7,#&DD
 BEQ MOSFILE
 TEQ R7,#&DA
 BEQ MOSARGS
 TEQ R7,#&D7
 BEQ MOSBGET
 TEQ R7,#&D4
 BEQ MOSBPUT
 TEQ R7,#&D1
 BEQ MOSGBPB
 TEQ R7,#&CE
 BNE NOTMOS
 SWI OPEN ;osfind
 B RETMOS
MOSGBPB MOV R7,R1
 MOV R5,#12
MOSGP1 LDRB R4,[R7,R5]
 STRB R4,[SP,#-1]!
 SUBS R5,R5,#1
 BNE MOSGP1
 LDRB R1,[R7]
 LDMFD SP!,{R2,R3,R4}
 SWI MULTIPLE
 STMFD SP!,{R2,R3,R4}
 MOV R5,#1
MOSGP2 LDRB R4,[SP],#1
 STRB R4,[R7,R5]
 ADD R5,R5,#1
 TEQ R5,#13
 BNE MOSGP2
 B RETMOS
MOSBPUT MOV R1,R2
 SWI BPUT
 B RETMOS
MOSBGET MOV R1,R2
 SWI BGET
 B RETMOS
MOSARGS MOV R1,R2
 SWI ARGS
 B RETMOS
MOSFILE MOV R7,R1
 MOV R5,#17
MOSFL1 LDRB R4,[R7,R5]
 STRB R4,[SP,#-1]!
 SUB R5,R5,#1
 CMP R5,#1
 BNE MOSFL1
 LDRB R2,[R7,#1]
 LDRB R1,[R7]
 ORR R1,R1,R2,LSL #8
 LDMFD SP!,{R2,R3,R4,R5}
 SWI FILE
 STMFD SP!,{R2,R3,R4,R5}
 MOV R5,#2
MOSFL2 LDRB R4,[SP],#1
 STRB R4,[R7,R5]
 ADD R5,R5,#1
 TEQ R5,#18
 BNE MOSFL2
 B RETMOS
MOSRDCH SWI READC
 B RETMOS
MOSNEWL SWI NEWLINE
 B RETMOS
MOSASCI TEQ R0,#13
 SWIEQ WRITEI+10
MOSWRCH SWI WRITEC
 B RETMOS
MOSWORD SWI WORD
 B RETMOS
MOSBYTE SWI BYTE
 B RETMOS
MOSCLI MOV R0,R1
 SWI CLI
RETMOS AND R0,R0,#&FF
 AND R1,R1,#&FF
 AND R2,R2,#&FF
 ORR R0,R0,R1,LSL #8
 ORR R0,R0,R2,LSL #16
 ORRCS R0,R0,#&1000000
 MOVS TYPE,#TINTEGER
 MOV PC,R14
NOTMOS MOVS R0,#0
 MOV PC,R14
QUIT BL DONES
 SWI EXIT
MUNGIG LDRB R10,[LINE],#1
 CMP R10,#13
 BNE MUNGIG
MUNGNL LDRB R10,[LINE],#1
 ADD LINE,LINE,#2
 CMP R10,#&FF
 SUBCS LINE,LINE,#4
 MOVCS PC,R14 ;exit with pointer to the cr
MUNGLE LDRB R10,[LINE],#1
MUNGLT CMP R10,#" "
 CMPNE R10,#":"
 BEQ MUNGLE
 CMP R10,#13
 BEQ MUNGNL
 CMP R10,#TELSE
 CMPNE R10,#TREM
 CMPNE R10,#TDEF
 CMPNE R10,#TDATA
 BEQ MUNGIG
 SUB LINE,LINE,#1
 MOV PC,R14
;process exceptional condition
;entry with r4 as the controller
;must not destroy r0 or UNTIL will not work
DOEXCEPTION TST R4,#&80 ;check for escape itself
 BNE ESCAPE
 TST R4,#&8000
 BNE DOTRACE
 MOV R4,#0
 STR R4,[ARGP,#ESCWORD]
 BL MSG
 = 0,"Unknown setting of exception control.",0
 ALIGN
DOTRACE LDR R5,[ARGP,#TRCNUM] ;check for trace type
 CMP R5,#0
 MOVLE PC,R14 ;if trcnum -ve or 0 then no line number trace
 LDRB R4,[LINE,#-4]
 CMP R4,#13
 MOVNE PC,R14 ;not at a place where number can be shown
 LDRB R4,[LINE,#-3]
 LDRB R6,[LINE,#-2]
 ADD R4,R6,R4,LSL #8
 BIC R6,R5,#TINTEGER
 CMP R4,R6
 MOVGT PC,R14 ;tracing numbers but not in range
 STMFD SP!,{R0,R14}
 MOV R0,R4
 TST R5,#TINTEGER
 SWIEQ WRITEI+"["
 SWINE WRITEI+"{"
 MOV TYPE,#0
 BL POSITE
 BL TRCEND
 LDMFD SP!,{R0,PC}
;store system
STORE LDMFD SP!,{R4,R5}
STOREA CMP R5,#5
 BHI STSTOR
 BEQ FPSTOR
 TEQ TYPE,#0
 BEQ ERTYPEINT
 MOV TYPE,R14
 BLMI SFIX
 CMP R5,#4
 BNE BYTSTO
 TST R4,#3
 STREQ FACC,[R4]
 MOVEQ PC,TYPE
 STRB FACC,[R4]
 MOV FGRD,FACC,LSR #8
 STRB FGRD,[R4,#1]
 MOV FGRD,FACC,LSR #16
 STRB FGRD,[R4,#2]
 MOV FGRD,FACC,LSR #24
 STRB FGRD,[R4,#3]
 MOV PC,TYPE
BYTSTO STRB FACC,[R4]
 MOV PC,TYPE
FPSTOR TEQ TYPE,#0
 BEQ ERTYPEINT
 MOV TYPE,R14
 BLPL IFLT
 STRB FACCX,[R4,#4]
 BIC FGRD,FACC,#&80000000
 ORR FGRD,FGRD,FSIGN ;fsign only 0 or &80000000!
 STRB FGRD,[R4]
 MOV FGRD,FGRD,ROR #8
 STRB FGRD,[R4,#1]
 MOV FGRD,FGRD,ROR #8
 STRB FGRD,[R4,#2]
 MOV FGRD,FGRD,ROR #8
 STRB FGRD,[R4,#3]
 MOV PC,TYPE
STSTOR CMP R5,#256
 BCS ERVARAR
 TEQ TYPE,#0
 BNE ERTYPESTR
 CMP R5,#128
 BNE ROPSTOR
 ADD R3,ARGP,#STRACC
;store string, doing reallocate
;r4: address of string information block (preserved)
;r2/clen: length of string (address of end) (preserved)
;r3: address of start of string (preserved)
;uses r0,r1,r5,r6,r7
STSTORE LOAD FACC,R4,R5,R1 ;entry from function return and local
 LDRB R1,[R4,#4] ;get current length
 ADD R1,R1,#3
 BIC R1,R1,#3 ;round current length to words
 SUB R5,CLEN,R3
 ADD R5,R5,#3
 BIC R5,R5,#3 ;r5=length required (OR 0)
 CMP R5,R1
 BEQ ALLOCY ;no need to fiddle with allocation
 LDR R6,[ARGP,#FSA] ;get free space pointer
 ADD R7,R1,FACC ;compute end of current string area
 TEQ R7,R6 ;does end of current string match free space?
 BEQ ALLOCEXTEND ;yes, so just add/subtract a few words
 ADD R6,ARGP,#FREELIST-4
 CMP R1,#0
 BEQ REALLOCATE ;no size to deallocate
;Deallocate the old chunk to the right free list: all possible chunk sizes
;live on their own free list, i.e. one list for sizes 4..252 so that
;reallocation does not involve searching. Also the minimum allocation size is
;one word since entries in the free lists do not need to have the sizes.
 LDR R7,[R6,R1] ;deallocate old block by inserting at head of right free list
;free list has pointer to next or 0
 STR FACC,[R6,R1] ;point list to me
 STR R7,[FACC] ;point me to rest of list
 CMP R5,#0
 BEQ STSTEX ;no size to reallocate for
;reallocate by looking at right free list
REALLOCATE LDR FACC,[R6,R5]
 TEQ FACC,#0
 BNE ALLOCOLD ;something on right list!!!
 LDR FACC,[ARGP,#FSA] ;allocate brand new space
 STRB FACC,[R4] ;update string block
 MOV R1,FACC,LSR #8
 STRB R1,[R4,#1]
 MOV R1,FACC,LSR #16
 STRB R1,[R4,#2]
 MOV R1,FACC,LSR #24
 STRB R1,[R4,#3]
ALLOCEXTEND ADD R1,FACC,R5
 STR R1,[ARGP,#FSA] ;update free space used
 ADD R1,R1,#1024
 CMP R1,SP
 BCC ALLOCX
 B ALLOCR
ALLOCOLD LDR R7,[FACC]
 STR R7,[R6,R5] ;unlink the found block
 STRB FACC,[R4]
 MOV R1,FACC,LSR #8
 STRB R1,[R4,#1]
 MOV R1,FACC,LSR #16
 STRB R1,[R4,#2]
 MOV R1,FACC,LSR #24
 STRB R1,[R4,#3] ;new address
ALLOCX MOV R1,R3
STSTMV LDR R5,[R1],#4
 STR R5,[FACC],#4
 CMP R1,CLEN
 BCC STSTMV
STSTEX SUB R0,CLEN,R3
 STRB R0,[R4,#4] ;write new length
 MOV PC,R14
ALLOCY CMP R5,#0
 BNE ALLOCX
 STRB R5,[R4,#4]
 MOV PC,R14
ROPSTOR ADD R0,ARGP,#STRACC
 TEQ R0,CLEN
 BEQ ROPSTX
 CMP R4,#&8000
 BCC ERDOLL
ROPMOV LDRB R1,[R0],#1
 STRB R1,[R4],#1
 TEQ R0,CLEN
 BNE ROPMOV
ROPSTX MOV R1,#13
 STRB R1,[R4],#1
 MOV PC,R14
 LNK Array
